library(GeoPressureR)
library(leaflet)
library(leaflet.extras)
library(raster)
library(dplyr)
library(ggplot2)
library(plotly)
knitr::opts_chunk$set(echo = params$printcode)
load(paste0("../data/6_basic_graph/", params$gdl_id, "_basic_graph.Rdata"))
load(paste0("../data/5_static_prob/", params$gdl_id, "_static_prob.Rdata"))

Pressure timeserie

pressure_na <- pam$pressure %>%
  mutate(obs = ifelse(isoutliar | sta_id == 0, NA, obs))
p <- ggplot() +
  geom_line(data = pam$pressure, aes(x = date, y = obs), colour = "grey") +
  # geom_point(data = subset(pam$pressure, isoutliar), aes(x = date, y = obs), colour = "black") +
  geom_line(data = pressure_na, aes(x = date, y = obs, color = factor(sta_id)), size = 0.5) +
  geom_line(data = do.call("rbind", shortest_path_timeserie), aes(x = date, y = pressure0, col = factor(sta_id)), linetype = 2) +
  theme_bw() +
  scale_colour_manual(values = col) +
  scale_y_continuous(name = "Pressure(hPa)")

ggplotly(p, dynamicTicks = T) %>% layout(showlegend = F)

Alitude

p <- ggplot() +
  # geom_line(data = pam$pressure, aes(x = date, y = obs), colour = "grey") +
  geom_line(data = do.call("rbind", shortest_path_timeserie), aes(x = date, y = altitude, col = factor(sta_id))) +
  theme_bw() +
  scale_colour_manual(values = col) +
  scale_y_continuous(name = "Altitude (m)")

ggplotly(p, dynamicTicks = T) %>% layout(showlegend = F)

Shortest path and simulated path

sta_duration <- unlist(lapply(static_prob_marginal, function(x) {
  as.numeric(difftime(metadata(x)$temporal_extent[2], metadata(x)$temporal_extent[1], units = "days"))
}))
pal <- colorFactor(col, as.factor(seq_len(length(col))))
m <- leaflet(width = "100%") %>%
  addProviderTiles(providers$Stamen.TerrainBackground) %>%
  addFullscreenControl() %>%
  addPolylines(lng = grl$shortest_path$lon, lat = grl$shortest_path$lat, opacity = 1, color = "#808080", weight = 3) %>%
  addCircles(lng = grl$shortest_path$lon, lat = grl$shortest_path$lat, opacity = 1, color = pal(factor(grl$shortest_path$sta_id, levels = pam$sta$sta_id)), weight = sta_duration^(0.3) * 10)

for (i in seq_len(nrow(path_sim$lon))) {
  m <- m %>%
    addPolylines(lng = path_sim$lon[i, ], lat = path_sim$lat[i, ], opacity = 0.5, weight = 1, color = "#808080") %>%
    addCircles(lng = path_sim$lon[i, ], lat = path_sim$lat[i, ], opacity = .7, weight = 1, color = pal(factor(grl$shortest_path$sta_id, levels = pam$sta$sta_id)))
}
m

Marginal probability map

li_s <- list()
l <- leaflet(width = "100%") %>%
  addProviderTiles(providers$Stamen.TerrainBackground) %>%
  addFullscreenControl()
for (i_r in seq_len(length(static_prob_marginal))) {
  i_s <- metadata(static_prob_marginal[[i_r]])$sta_id
  info <- metadata(static_prob_marginal[[i_r]])$temporal_extent
  info_str <- paste0(i_s, " | ", info[1], "->", info[2])
  li_s <- append(li_s, info_str)
  l <- l %>%
    addRasterImage(static_prob_marginal[[i_r]], colors = "OrRd", opacity = 0.8, group = info_str) %>%
    addCircles(lng = grl$shortest_path$lon[i_s], lat = grl$shortest_path$lat[i_s], opacity = 1, color = "#000", weight = 10, group = info_str)
}
l %>%
  addLayersControl(
    overlayGroups = li_s,
    options = layersControlOptions(collapsed = FALSE)
  ) %>%
  hideGroup(tail(li_s, length(li_s) - 1))

Appendix

Stationay period information

pam$sta
##                  start                 end sta_id
## 1  2018-07-15 00:00:00 2018-08-19 16:10:00      1
## 2  2018-08-19 19:05:00 2018-08-19 19:55:00      2
## 3  2018-08-19 20:25:00 2018-08-20 14:35:00      3
## 4  2018-08-20 16:15:00 2018-08-22 12:25:00      4
## 5  2018-08-22 12:45:00 2018-08-27 13:25:00      5
## 6  2018-08-27 20:25:00 2018-08-28 12:15:00      6
## 7  2018-08-28 12:35:00 2018-08-29 12:10:00      7
## 8  2018-08-29 20:30:00 2018-08-30 14:45:00      8
## 9  2018-08-30 14:50:00 2018-08-31 13:25:00      9
## 10 2018-08-31 15:50:00 2018-09-01 20:30:00     10
## 11 2018-09-01 21:35:00 2018-09-02 15:20:00     11
## 12 2018-09-02 18:55:00 2018-09-03 17:35:00     12
## 13 2018-09-03 17:45:00 2018-09-05 13:35:00     13
## 14 2018-09-05 22:30:00 2018-09-06 13:40:00     14
## 15 2018-09-06 22:40:00 2018-09-07 13:55:00     15
## 16 2018-09-07 23:25:00 2018-09-08 13:30:00     16
## 17 2018-09-08 22:05:00 2018-09-09 13:40:00     17
## 18 2018-09-09 23:45:00 2018-09-10 14:50:00     18
## 19 2018-09-10 22:30:00 2018-09-11 13:45:00     19
## 20 2018-09-11 14:20:00 2018-09-14 23:35:00     20
## 21 2018-09-15 00:10:00 2018-09-15 13:35:00     21
## 22 2018-09-15 13:50:00 2018-09-20 16:45:00     22
## 23 2018-09-20 16:55:00 2018-09-21 13:30:00     23
## 24 2018-09-21 14:40:00 2018-09-21 23:35:00     24
## 25 2018-09-22 00:05:00 2018-09-23 23:15:00     25
## 26 2018-09-24 00:05:00 2018-09-27 18:15:00     26
## 27 2018-09-27 23:35:00 2018-09-28 13:45:00     27
## 28 2018-09-29 00:05:00 2018-09-29 13:50:00     28
## 29 2018-09-29 23:50:00 2018-09-30 14:10:00     29
## 30 2018-10-01 00:55:00 2018-10-01 14:35:00     30
## 31 2018-10-02 00:15:00 2018-10-02 14:10:00     31
## 32 2018-10-03 01:10:00 2018-10-03 16:30:00     32
## 33 2018-10-03 18:05:00 2018-10-04 14:05:00     33
## 34 2018-10-04 22:45:00 2018-10-05 14:15:00     34
## 35 2018-10-06 01:25:00 2018-10-06 14:45:00     35
## 36 2018-10-06 21:45:00 2018-10-07 15:10:00     36
## 37 2018-10-08 01:50:00 2018-10-08 15:30:00     37
## 38 2018-10-09 01:55:00 2018-10-09 15:40:00     38
## 39 2018-10-10 01:40:00 2018-10-16 23:20:00     39
## 40 2018-10-17 00:10:00 2018-10-22 14:55:00     40
## 41 2018-10-22 20:00:00 2018-10-23 14:55:00     41
## 42 2018-10-23 15:25:00 2018-10-24 00:55:00     42
## 43 2018-10-24 02:15:00 2018-10-24 14:55:00     43
## 44 2018-10-24 17:25:00 2018-10-25 00:35:00     44
## 45 2018-10-25 02:20:00 2018-10-25 15:00:00     45
## 46 2018-10-25 15:15:00 2018-10-26 01:15:00     46
## 47 2018-10-26 02:25:00 2018-10-26 21:05:00     47
## 48 2018-10-26 22:10:00 2018-10-27 15:00:00     48
## 49 2018-10-27 15:20:00 2018-10-28 01:40:00     49
## 50 2018-10-28 02:20:00 2018-10-28 15:00:00     50
## 51 2018-10-28 18:30:00 2018-10-31 16:05:00     51
## 52 2018-11-01 01:50:00 2018-11-01 17:45:00     52
## 53 2018-11-01 20:35:00 2018-11-02 17:50:00     53
## 54 2018-11-03 01:10:00 2018-11-05 21:35:00     54
## 55 2018-11-05 21:40:00 2018-11-06 22:45:00     55
## 56 2018-11-06 22:55:00 2018-11-07 18:15:00     56
## 57 2018-11-07 18:45:00 2018-11-08 20:30:00     57
## 58 2018-11-08 20:40:00 2018-11-09 15:30:00     58
## 59 2018-11-09 15:50:00 2018-11-10 02:20:00     59
## 60 2018-11-10 02:45:00 2018-11-10 15:30:00     60
## 61 2018-11-10 16:05:00 2018-11-10 23:45:00     61
## 62 2018-11-11 00:30:00 2018-11-17 15:35:00     62
## 63 2018-11-17 17:05:00 2018-11-18 01:30:00     63
## 64 2018-11-18 02:35:00 2018-11-18 15:40:00     64
## 65 2018-11-18 15:55:00 2018-11-19 02:20:00     65
## 66 2018-11-19 02:30:00 2018-11-19 16:30:00     66
## 67 2018-11-20 02:25:00 2018-11-20 17:25:00     67
## 68 2018-11-20 23:00:00 2018-11-21 22:15:00     68
## 69 2018-11-22 02:25:00 2018-11-22 18:05:00     69
## 70 2018-11-23 02:05:00 2018-11-23 18:45:00     70
## 71 2018-11-24 01:40:00 2018-11-24 16:15:00     71
## 72 2018-11-24 21:35:00 2018-11-25 18:25:00     72
## 73 2018-11-25 19:25:00 2018-11-26 20:15:00     73
## 74 2018-11-26 20:40:00 2018-11-27 02:05:00     74
## 75 2018-11-27 02:10:00 2019-03-14 20:20:00     75
## 76 2019-03-15 03:15:00 2019-03-15 22:35:00     76
## 77 2019-03-16 00:45:00 2019-03-16 16:10:00     77
## 78 2019-03-16 16:30:00 2019-03-16 23:30:00     78
## 79 2019-03-17 00:25:00 2019-03-17 16:15:00     79
## 80 2019-03-17 16:25:00 2019-03-18 03:40:00     80
## 81 2019-03-18 03:40:00 2019-03-18 16:10:00     81
## 82 2019-03-18 16:25:00 2019-03-19 16:15:00     82
## 83 2019-03-19 16:40:00 2019-03-20 16:15:00     83
## 84 2019-03-21 02:20:00 2019-03-21 15:40:00     84
## 85 2019-03-21 16:05:00 2019-03-22 15:55:00     85
## 86 2019-03-23 02:50:00 2019-03-23 15:55:00     86
## 87 2019-03-24 02:55:00 2019-03-24 15:55:00     87
## 88 2019-03-25 02:20:00 2019-03-25 16:00:00     88
## 89 2019-03-26 01:10:00 2019-03-26 18:35:00     89
## 90 2019-03-26 20:50:00 2019-03-27 16:50:00     90
## 91 2019-03-27 21:00:00 2019-03-28 20:50:00     91
## 92 2019-03-28 22:10:00 2019-03-30 19:15:00     92
## 93 2019-03-30 20:50:00 2019-03-31 12:40:00     93

Parameter used for the simulation

set
## # A tibble: 1 × 30
##   include gdl_id crop_start          crop_end            thr_dur extent_N
##   <lgl>   <chr>  <dttm>              <dttm>                <dbl>    <dbl>
## 1 TRUE    22BS   1900-01-01 00:00:00 2100-01-01 00:00:00      24       50
## # … with 24 more variables: extent_W <dbl>, extent_S <dbl>, extent_E <dbl>,
## #   map_scale <dbl>, map_max_sample <dbl>, map_margin <dbl>, prob_map_s <dbl>,
## #   prob_map_thr <dbl>, shift_k <dbl>, calib_lon <dbl>, calib_lat <dbl>,
## #   calib_1_start <dttm>, calib_1_end <dttm>, calib_2_start <lgl>,
## #   calib_2_end <lgl>, calib_2_lon <lgl>, calib_2_lat <lgl>,
## #   prob_light_w <dbl>, RingNo <lgl>, scientific_name <lgl>, common_name <chr>,
## #   mass <lgl>, wing_span <lgl>, Color <lgl>